
let get_fresh_temp =
  let next_id = ref 0 in
    fun () ->
      let id = !next_id in
	incr next_id;
	Printf.sprintf "_t%d" id

(*let emit s = output_string stdout s *)

let wraps ch typs f =
  let emit s =
      output_string ch s;
      output_string ch "\n"
    in
  let tmps = List.map (fun typ -> (typ, get_fresh_temp ())) typs in
    emit "{\n";
    List.iter (fun (typ, tmp) -> emit (Printf.sprintf "%s %s;\n" typ tmp)) tmps;
    f (List.map snd tmps);
    emit "}\n"

let wrap ch cls f =
  wraps ch [cls]
    (function
	 [tmp] -> f tmp
       | _ -> assert false (* IMPOSSIBLE *)
    )

let string_of_args fields = (String.concat ", " 
			       (List.map (fun (typ,field_name) -> (Printf.sprintf "%s %s" typ field_name)) fields)
			    )
  
let rec string_of_pair =        	                      
   	function
	  |Const.Int x -> string_of_int x
	  |Const.Float x -> string_of_float x
	  |Const.Bool x -> string_of_bool x
	  |Const.String x -> x
	  |Const.Pair (x,y) -> (String.concat ", " [(string_of_pair x) ; (string_of_pair y)])
   

let compile_expr ch st =
  let emit s =
    output_string ch s;
    output_string ch "\n"
  in
  let rec aux env dest =
    let string_of_string s = Printf.sprintf "\"%s\"" (String.escaped s) in
    let alloc typ value = (Printf.sprintf "new %s(%s)" typ value) in
    let type_of_decl st env dec =  Type.type_of st env (snd dec) in
    let aux_decl env dest dec = aux env dest (snd dec) in 
    let aux_const dest k =
      let rec aux =
	function
	  |Const.Int x -> alloc "Int" (string_of_int x)
	  |Const.Float x -> alloc "Float" (string_of_float x)
	  |Const.Bool x -> alloc "Bool" (string_of_bool x)
	  |Const.String x -> alloc "String" (string_of_string x)
	  |Const.Pair (x,y) as p -> alloc "Pair" (String.concat ", " [aux x;aux y]) (*(string_of_pair p)*)
      in
	emit (Printf.sprintf "%s = %s;\n" dest (aux k))
    in
      function
	  AstO.Const k -> aux_const dest k
	    
	| AstO.Id name -> emit (Printf.sprintf "%s = %s;\n" dest name)
	    
	| AstO.Cast (cls, expr) ->
	    wrap ch (Type.type_of st env expr)
	      (fun tmp ->
		 aux env tmp expr;
		 emit (Printf.sprintf "%s = (%s)%s;\n" dest cls tmp)
	      )
	    
	| AstO.FieldAccess (expr, field_name) ->
	    let cls = Type.type_of st env expr in
	      wrap ch cls
		(fun tmp ->
		   aux env tmp expr;
		   emit (Printf.sprintf "%s = %s.%s;\n" dest tmp field_name)
		)
		
	| AstO.MethodCall (expr, method_name, exprs) ->
	    let typ = Type.type_of st env expr
	    and typs = List.map (Type.type_of st env) exprs in
	    wrap ch typ
	      (fun tmp ->
		 aux env tmp expr;
		 wraps ch typs
		   (fun tmps ->
		      List.iter2 (aux env) tmps exprs;
		      emit (Printf.sprintf "%s = %s.%s(%s);" dest tmp method_name (String.concat ", " tmps))
		   )
	      )
	      
	| AstO.StaticCall (cls, method_name, exprs) ->
	    let typs = List.map (Type.type_of st env) exprs in
	      wraps ch typs
		(fun tmps ->
		   List.iter2 (aux env) tmps exprs;
		   emit (Printf.sprintf "%s = %s.%s(%s);" dest cls method_name (String.concat ", " tmps))
		)

	| AstO.Let (decls, expr) ->
	    let typs = List.map (type_of_decl st env) decls in
	      wraps ch typs
		(fun tmps ->
		   List.iter2 (aux_decl env) tmps decls;
		   emit "{\n";
		   List.iter2
		     (fun (x, tmp) typ ->
			emit (Printf.sprintf "%s %s = %s;" typ x tmp))
		     (List.map2 (fun (x, _) tmp -> (x, tmp)) decls tmps)
		     typs;
		   aux (List.map2 (fun (x, _) typ -> (x,Type.Class typ)) decls typs @ env) dest expr;
		   emit "}\n"
	      )
		
	| AstO.New (decls, expr) ->
	    emit "{\n";
	    List.iter
	      (fun (x, typ, _) ->
		 emit (Printf.sprintf "%s %s = new %s();" typ x typ))
	      decls;
	    let env' = List.map (fun (x, typ, _) -> (x,Type.Class typ)) decls @ env in
	      List.iter
	      (fun (x, _, exprs) ->
		 let typs = List.map (Type.type_of st env') exprs in
		   wraps ch typs
		     (fun tmps ->
			List.iter2 (aux env') tmps exprs;
			emit (Printf.sprintf "%s.%s(%s);" x "__initWith" (String.concat ", " tmps))
		     )
	      )
		decls;
	      aux env' dest expr;
	      emit "}\n"
		
	| AstO.If (expr1, expr2, expr3) ->
	   (* let typ = Type.type_of env expr2 in *)
	      wrap ch "Bool"
		(fun tmp ->
		   aux env tmp expr1;
		   emit (Printf.sprintf "if (((Bool)%s).toBool()) {\n" tmp);
		   aux env dest expr2;
		   emit "\n} else {\n";
		   aux env dest expr3;
		   emit "}\n"
		)
		
  in
    aux
      
let compile_method st ch cls (AstO.Method (qual, typ, method_name, args, expr_opt)) =
  let emit s =
    output_string ch s;
    output_string ch "\n"
  in
    if qual = AstO.Static then
      emit "static ";
    emit (Printf.sprintf "public %s %s(%s)" typ method_name
	    (String.concat ", "
	       (List.map (fun (typ, name) -> typ ^ " " ^ name) args)));
    match expr_opt with
	None -> emit "{ return null; }\n";
      | Some expr ->
	  let env = (if qual = AstO.Static then [] 
		     else [("this",Type.Class cls)]) @
	    (List.map (fun (typ,var) -> (var,Type.Class typ)) args) in
	    emit "{\n";
	    wrap ch (Type.type_of st env expr)
	      (fun tmp ->
		 compile_expr ch st env tmp expr;
		 emit (Printf.sprintf "return %s;" tmp);
	      );
	    emit "}\n"
	      
let compile_class st ch (AstO.Class (name, base, fields, methods) as cls) =
  let emit s =
    output_string ch s;
    output_string ch "\n"
  in
  emit (Printf.sprintf "public class %s extends %s" name base);
  emit "{\n";
  List.iter (fun (typ,field_name) -> emit (Printf.sprintf "private %s %s;\n" typ field_name)) fields;  
  emit (Printf.sprintf "public void __initWith(%s) {\n" (string_of_args fields));
  List.iter (fun (_,field_name) -> emit (Printf.sprintf "this.%s = %s;\n" field_name field_name)) fields;
  emit "}";
  List.iter (fun meth -> compile_method ((Type.Class name,cls) :: st) ch name meth) methods;
  emit "}\n"


let generate_class st (AstO.Class (name, _, _, _) as cls) =
    let ch = open_out (name ^ ".java") in  
    prerr_endline (Printf.sprintf "Generating class %s..." name);
    compile_class st ch cls;
    close_out ch 
    
  
